home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 011 / ffix0531.arc / RSB20530.MRG < prev    next >
Encoding:
Text File  |  1988-05-30  |  37.7 KB  |  934 lines
  1. * ------------[ BLED merge (c) Ken Goosens ]-------------
  2. * Merge this against RBBSSUB2.BAS to produce RSB20530.BAS
  3. * RBBSSUB2.BAS:  Date 3-25-1988  Size 122727 bytes
  4. * ------------[ Created 05-30-1988 14:38:20 ]------------
  5. * REPLACING old line(s) by new
  6. ' $linesize:132
  7. ' $title: 'RBBSSUB2.BAS CPC16-1A, Copyright 1986 - 88 by D. Thomas Mack'
  8. '  Copyright 1987 by D. Thomas Mack, all rights reserved.
  9. '  Name ...............: RBBSSUB2.BAS
  10. '  Written by .........: D. Thomas Mack
  11. '  First Released .....: June 29, 1986
  12. '  Subsequent Releases.: September 28, 1986, March 15, 1987, June 7, 1987
  13. '                      : November 15, 1987, March 27, 1988
  14. '  Copyright ..........: 1986, 1987, 1988
  15. '  Purpose.............: The Remote Bulletin Board System for the IBM PC,
  16. '                        RBBS-PC.BAS utilizes a lot of common subroutines.
  17. '                        Those that do not require error trapping are
  18. '                        incorporated within RBBSSUB2.BAS and RBBSSUB3.BAS
  19. '                        as separately callable subroutines in order to free
  20. '                        up as much code as possible within the 64K code
  21. '                        segment used by RBBS-PC.BAS.
  22. '  Parameters..........: Most parameters are passed via a COMMON statement.
  23. '
  24. ' Subroutine  Line               Function of Subroutine
  25. '   Name     Number
  26. '  ANSWERIT     201   Answer the telephone when it rings
  27. '  ASCCODES     129   Allow a CONFIG string to have any ASCII value
  28. '  BADCHAR      455   Check user name for invalid characters
  29. '  BADFILE    20741   Check for system crash attempt with bad device name
  30. '  BADNAME    20235   Check for system crash attempt with bad file name
  31. '  BAUD450     5507   Allow 300 baud callers to bump up to 450 baud
  32. '  BRKFNAME   20282   Break a file name into it's component parts
  33. * ------[ first line different ]------
  34. '  COPYWRIT      97   *** REMOVED ***                                   'AL0402
  35. '  DEFALTU     9600   Write out the user's defaults
  36. '  DENYACCESS  1386   Downgrade security so access denied
  37. '  DOOREXIT   10987   Set up a .BAT file to exit RBBS-PC and go to a "door"
  38. '  DOSEXIT    10934   Set up a .BAT file to exit to DOS (second level)
  39. '  GETARC     20141   Handle request for verbose arc listing
  40. '  GETCOMND      97+  Get RBBS-PC's node id from command line
  41. '  GETIME      9140   Calculates callers elapsed time (hours, minutes, seconds)
  42. '  GOIDLE        90   Release resources when waiting for keyboard input
  43. '  KILLMSG     3955   Delete old or unnecessary messages
  44. '  LIBRARY    21105   *** REMOVED ***                                   'AL0402
  45. '  LINE25       949   Build and/or update line 25 of RBBS-PC's local screen
  46. '  LINEEDIT    3700   Edit a line while minimizing string space consumption
  47. '  LOGERROR   13660   Log error message to CALLERS file
  48. '  LPRNT       1480   Subroutine to write to local display
  49. '  MLINIT        10   Handle MultiLink initialization/de-initialization
  50. '  PASSWRD      667   Verify user & message passwords
  51. '  QTPUT       1477   Fast, but limited, "TPUT" equivalent
  52. '  RBBSEXIT   10992   Common RBBS-PC exit to transfer control to other programs
  53. '  RECOVMSG   10410   Recover a deleted message
  54. '  REMNONALF   5100   Removes non-alpha characters from a string
  55. '  SENDNAME   20295   *** COMMENTED ***                                 'AL0402
  56. '  SETBAUD     1654   Set baud rate in the 8250 chip of the RS232 interface
  57. '  SETCRLF     1496   Set up the necessary carriage return/line feed string
  58. '  SETTHREAD   4031   Set up request for threading thru messages
  59. '  SKIPLINE    1485   Write a # of blank lines to the communications port
  60. '  SRCHCMND    1240   Searches list of commands in RBBS for a request
  61. '  SVIOLATION  1380   Process a security violation
  62. '  SYSMENU      112   Displays sysop menu/status
  63. '  TESTUSER   20310   *** COMMENTED ***                                 'AL0402
  64. '  TGET        1500   Read a line from the communications port
  65. '  TPUT        1400   Write a line to the communications port
  66. '  TRIM          99   Strip leading and trailing blanks from a string
  67. '  TRIMTRAIL     99   Strip off specified string off end of another string
  68. '  UNTILRIGHT 12880   Ask a question until user says answer is right
  69. '  UPDATEU    10600   Updates the user record on loging off/exiting RBBS-PC
  70. '  UPDTUPLOAD 20705   Updates upload directory file
  71. '  VIEWHELP    1330   Processes help command
  72. '  WILDCARD   20285   Determines whether string matches a pattern
  73. '  WORDINFILE 10976   Find a whole word within a file/menu
  74. '  XFERTYPE   21600   Identify the file transfer protocol
  75. '
  76. '  $INCLUDE: 'RBBS-VAR.BAS'
  77. '
  78. '  $SUBTITLE: 'MLINIT - MultiLink initialization/deinitialization'
  79. '  $PAGE
  80. '
  81. '  SUBROUTINE NAME    -- MLINIT
  82. '
  83. '  INPUT PARAMETERS   --  MLPARM = 1             INITIALIZE AT STARTUP OR RE-
  84. '                                                CYLCE TIME
  85. '                         MLPARM = 2             DE-INITIALIZE ON EXITING TO
  86. '                                                A DOOR OR DOS REMOTELY
  87. '                         MLPARM = 3             DE-QUEUE COMMUNICATIONS PORTS
  88. '                         MLPARM = 4             CHECK FOR MULTILINK PRESENT
  89. '                         DOORS.TERMINAL.TYPE
  90. '                         BAUD.TEST
  91. '                         COM.PORT$
  92. '                         COMPUTER.TYPE
  93. '
  94. '  OUTPUT PARAMETERS  --  NONE
  95. '
  96. '  SUBROUTINE PURPOSE --  TO TEST FOR THE PRESENCE OF MULTI-LINK AND SET
  97. '                         MULTI LINK OPTIONS TO BE COMPATIBLE WITH RBBS-PC
  98. '
  99.       SUB MLINIT (MLPARM) STATIC
  100.     DEF SEG = 0
  101.     IF COMPUTER.TYPE = 1 _
  102.        GOTO 10
  103.     IF NOT MLCOM THEN _
  104.        IF NETWORK.TYPE <> 1 THEN _
  105.           GOTO 10
  106.     MULTI.LINK.PRESENT = PEEK(&H1FE) + 256 * PEEK(&H1FF)
  107.     IF MULTI.LINK.PRESENT = 0 THEN _
  108.        GOTO 10
  109.     ON MLPARM GOSUB 30,20,60,10
  110. * REPLACING old line(s) by new
  111. 90 IF MLCOM OR NETWORK.TYPE = 1 THEN _
  112.       CALL MLINIT(5) : _
  113.       EXIT SUB
  114.    CALL GIVEBACK
  115.    END SUB
  116. '  $SUBTITLE: 'COPYWRIT - subroutine to display RBBS-PC copyright'
  117. '  $PAGE
  118. '
  119. '  SUBROUTINE NAME    -- COPYWRIT
  120. '
  121. '  INPUT PARAMETERS   --  NONE
  122. '
  123. '  OUTPUT PARAMETERS  --  NONE
  124. '
  125. '  SUBROUTINE PURPOSE --  TO DISPLAY RBBS-PC'S COPYRIGHT NOTICE ON THE LOCAL
  126. '                         SYSOP'S SCREEN
  127. '
  128. * ------[ first line different ]------
  129. '      SUB COPYWRIT STATIC
  130. '   END SUB
  131. ' $SUBTITLE: 'GETCOMND - subroutine to get command from command line'
  132. ' $PAGE
  133. '
  134. '  SUBROUTINE NAME    -- GETCOMND
  135. '
  136. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  137. '                        CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE TO
  138. '                                             USE AS A MODEL WHEN CREATING THE
  139. '                                             .DEF FILE NAME TO BE USED BY THIS
  140. '                                             COPY OF RBBS-PC.
  141. '
  142. '                        COMMAND LINE         COMMAND LINE USED TO INVOKE
  143. '                                             RBBS-PC IN THE FORM:
  144. '
  145. '             RBBS-PC.EXE x filename DEBUG /time /baud
  146. '
  147. '   WHERE THE OPTIONAL PARAMETERS ARE:
  148. '
  149. '  x       IS THE NODE ID IN THE RANGE 1-9,0,A-Z
  150. ' filename IS THE FULLY QUALIFIED FILE NAME TO USE AS THE ".DEF" FILE
  151. ' DEBUG    IS A DEBUGGING SWITCH
  152. ' /time    IS THE TIME OF DAY FOR RBBS-PC TO RETURN TO THE CALLER
  153. ' /baud    IS THE BAUD RATE OF THE CALLER IF RBBS-PC IS BEING SHELLED TO BY
  154. '             ANOTHER COMMUNICATIONS PROGRAM (THE COMMUNICATIONS PORT BEING
  155. '             USED IS ASSUMED TO BE THE ONE INPUTTED VIA THE RBBS-PC CONFIG
  156. '             PROGRAM
  157. '
  158. ' IF NO PARAMETERS ARE SUPPLIED, RBBS-PC ASSUMES THAT THE .DEF FILE NAME IS
  159. ' RBBS-PC.DEF AND THAT THE NODE IS NODE 1.
  160. '
  161. '  OUTPUT PARAMETERS  -- CONFIG.FILENAME$     NAME OF RBBS-PC ".DEF" FILE FOR
  162. '                                             THIS COPY OF RBBS-PC TO USE
  163. '                        NODE.RECORD.INDEX    RECORD NUMBER WITHIN THE
  164. '                                             MESSAGES FILE FOR THIS "NODE"
  165. '                                             (RANGE IS 2 TO 36)
  166. '
  167. '  SUBROUTINE PURPOSE --  TO GET NODE ID FROM COMMAND LINE
  168. '
  169.       SUB GETCOMND (PASSED.DEBUG,NETIME$) STATIC                        'TRAIL
  170.       STATIC DEBUG
  171. '
  172. ' *****************************************************************************
  173. ' *  GET NODE ID FROM COMMAND LINE                                            *
  174. ' *****************************************************************************
  175. '
  176.       PM$ = COMMAND$
  177.       CALL ALLCAPS(PM$)
  178.       NETBAUD$ = ""                                                     'TRAIL
  179.       IF INSTR(PM$,"/") = 0 THEN _
  180.          GOTO 98
  181. '
  182. ' *****************************************************************************
  183. ' * PARSE THE COMMAND LINE FOR TWO POSITIONAL SWITCHES FOR NET MAIL           *
  184. ' *****************************************************************************
  185. '
  186.       CMD.LINE$ = MID$(PM$,INSTR(PM$,"/") + 1,LEN(PM$) - INSTR(PM$,"/"))
  187.       PM$ = LEFT$(PM$,INSTR(PM$,"/") - 1)
  188.       IF INSTR(CMD.LINE$,"/") = 0 THEN _
  189.          NETIME$ = CMD.LINE$                                            'TRAIL
  190.       IF INSTR(CMD.LINE$,"/") > 0 THEN _                                'TRAIL
  191.          NETIME$ = LEFT$(CMD.LINE$,INSTR(CMD.LINE$,"/") - 1) : _
  192.          NETBAUD$ = MID$(CMD.LINE$,INSTR(CMD.LINE$,"/") + 1)
  193.       CALL TRIM(NETIME$)
  194.       CALL TRIM(NETBAUD$)
  195. * DELETING old line(s)
  196. 97
  197. * REPLACING old line(s) by new
  198. 201 SUBROUTINE.PARAMETER = -10
  199.     CALL CARRIER
  200.     IF SUBROUTINE.PARAMETER = 0 THEN _
  201.        GOTO 210
  202.     EXIT.TO.DOORS = FALSE
  203.     PRIVATE.DOOR = FALSE
  204. '
  205. ' *****************************************************************************
  206. ' *  RESET THE MODEM VIA THE MODEM CONTROL REGISTER  TO ASSURE IT IS READY    *
  207. ' *****************************************************************************
  208. '
  209. * ------[ first line different ]------
  210.     STATE%=0                                                       'FOSS
  211.     CALL FOSDTR(COMPORT%,STATE%)                                   'FOSS
  212. '    OUT MODEM.CONTROL.REGISTER,&H4
  213.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  214. '
  215. ' *****************************************************************************
  216. ' *  CLEAR THE MODEM CONTROL REGISTER PRIOR TO OPEN THE COMMUNICATIONS PORT   *
  217. ' *****************************************************************************
  218. '
  219.     STATE%=1                                                      'FOSS
  220.     CALL FOSDTR(COMPORT%,STATE%)                                  'FOSS
  221. '    OUT MODEM.CONTROL.REGISTER,&H0
  222.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  223. * REPLACING old line(s) by new
  224. 235 EIGHT.BIT = TRUE
  225.     SUBROUTINE.PARAMETER = -10
  226.     CALL CARRIER
  227.     IF SUBROUTINE.PARAMETER = 0 AND _
  228.        EXIT.TO.DOORS THEN _
  229.        CALL READPROF : _
  230.        SUBROUTINE.PARAMETER = 1 : _
  231.        GOTO 335
  232.     IF SUBROUTINE.PARAMETER = 0 AND _
  233.        EXPECT.ACTIVE.MODEM THEN _
  234. * ------[ first line different ]------
  235.        BAUD.TEST = VAL(NETBAUD$) : _                                    'TRAIL
  236.        GOTO 328
  237.     IF EXPECT.ACTIVE.MODEM OR _
  238.        EXIT.TO.DOORS THEN _
  239.        SUBROUTINE.PARAMETER = 4 : _
  240.        EXIT SUB
  241.     IF SUBROUTINE.PARAMETER = 0 THEN _
  242.        GOTO 324
  243.     PCJR = FALSE
  244.     IF COMPUTER.TYPE = 2 AND _
  245.        COM.PORT$ = "COM1" AND _
  246.        MODEM.STATUS.REGISTER = 1022 THEN _
  247.        MODEM.GO.OFFHOOK.COMMAND$ = CHR$(14) + _
  248.                                    "P" : _
  249.        PCJR = TRUE
  250.     CALL SYSMENU
  251.     IF PCJR THEN _
  252.        A$ = CHR$(14) + _
  253.             "I" _
  254.     ELSE A$ = MODEM.RESET.COMMAND$
  255.     CALL MODEMPUT (A$)
  256.     CALL DELAYIT (MODEM.INIT.WAIT.TIME)
  257.     IF PCJR THEN _
  258.        A$ = CHR$(14) + _   ' PC-JR'S MODEM COMMAND IDENTIFIER
  259.               "C 0," + _   ' SET "AUTO-ANSWER" OFF ON PC-JR'S MODEM
  260.               "S 1," + _   ' SET SPEED TO 300 BAUD ON PC-JR'S MODEM
  261.               "H" _        ' MANUALLY HANG UP THE PHONE (IF NOT ALREADY)
  262.     ELSE A$ = MODEM.INIT.COMMAND$
  263.     CALL MODEMPUT (A$)
  264.     IF PCJR THEN _
  265.        A$ = CHR$(14) + _
  266.             "F 4" : _
  267.        CALL MODEMPUT (A$)
  268.     RINGBACK = FALSE
  269.     LOCATE 16,55
  270.     IF REQUIRED.RINGS = 0 THEN _
  271.        CALL LPRNT("WAITING FOR CARRIER",0) : _
  272.        GOTO 237
  273.     IF MID$(MODEM.INIT.COMMAND$, _
  274.           INSTR(MODEM.INIT.COMMAND$,"S0") + 3,3) = "255" THEN _
  275.        CALL LPRNT("RING BACK SYSTEM",0) : _
  276.        RINGBACK = TRUE : _
  277.        GOTO 236
  278.     CALL LPRNT("WAITING FOR RING ",0)
  279. * REPLACING old line(s) by new
  280. * ------[ first line different ]------
  281. 276 CALL FOSREADAHEAD(COMPORT%,CHAR%)                               'FOSS
  282.     IF CHAR% <> -1 THEN _                                           'FOSS
  283.        CALL FLUSHCOM(X$) : _
  284.        IF SUBROUTINE.PARAMETER = - 1 THEN _
  285.           EXIT SUB
  286.     IF PCJR THEN _
  287.        GOTO 320
  288.     A$ = MODEM.COUNT.RINGS.COMMAND$
  289.     CALL MODEMPUT (A$)
  290.     CALL DELAYIT (MODEM.COMMAND.DELAY.TIME)
  291. * REPLACING old line(s) by new
  292. 335 IF NOT RELIABLE.MODE THEN _
  293. * ------[ first line different ]------
  294.        A = INSTR(TRANSFER.OPTIONS$,"G)") : _                            'AL0402
  295.        IF A > 0 THEN _
  296.           TRANSFER.OPTIONS$ = LEFT$(TRANSFER.OPTIONS$,A - 1) + _
  297.                               MID$(TRANSFER.OPTIONS$,A + 11)            'AL0402
  298.     DONT.WRITE = 0
  299.     END SUB
  300. ' $SUBTITLE: 'BADCHAR - subroutine to check user names for bad characters'
  301. ' $PAGE
  302. '
  303. '  SUBROUTINE NAME    -- BADCHAR
  304. '
  305. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  306. '                           PASSED.NAME$           USER NAME
  307. '
  308. '  OUTPUT PARAMETERS  --    PASSED.NAME$           USER NAME WILL CONTAIN ""
  309. '                                                  IF BAD CHARACTERS FOUND
  310. '
  311. '  SUBROUTINE PURPOSE -- TO CHECK USER NAMES FOR INVALID CHARACTERS
  312. '
  313.     SUB BADCHAR (PASSED.NAME$) STATIC
  314. '
  315.     J = 1
  316.     XX = LEN(PASSED.NAME$)
  317. * REPLACING old line(s) by new
  318. 950 IF NOT SNOOP THEN _
  319.        EXIT SUB
  320.     CURSOR.LINE = CSRLIN
  321.     CURSOR.ROW = POS(0)
  322.     HH = LEN(ACTIVE.USER.NAME$) + _
  323.          LEN(CI$) + _
  324.          LEN(LINE.25$) + _
  325.          LEN(STR$(USER.SECURITY.LEVEL)) + _
  326.          18
  327.     IF AUTODOWNLOAD.AVAILABLE THEN _
  328.        HH = HH + 4
  329.     LOCATE 25,1
  330.     IF NETWORK.TYPE = 0 THEN _
  331.        IF AUTODOWNLOAD.AVAILABLE THEN _
  332.           LOCK.STATUS$ = SPACE$(3) + _
  333.                          "AD  " + _
  334.                          TIME.LOGGED.ON$ _
  335. * ------[ first line different ]------
  336.     ELSE LOCK.STATUS$ = SPACE$(3) + _
  337.                         TIME.LOGGED.ON$
  338.     IF HH > 79 THEN _
  339.        HH = 78
  340.     LINE.25.HOLD$ = LINE.25$ + _
  341.                     SPACE$(79 - HH) + _
  342.                     STR$(USER.SECURITY.LEVEL) + _
  343.                     " " + _
  344.                     ACTIVE.USER.NAME$ + _
  345.                     " " + _
  346.                     CI$ + _
  347.                     " " + _
  348.                     LOCK.STATUS$
  349.     CALL LPRNT(LINE.25.HOLD$,0)
  350.     LOCATE CURSOR.LINE,CURSOR.ROW
  351.     END SUB
  352. ' $SUBTITLE: 'SRCHCMND    - subroutine to search command list'
  353. ' $PAGE
  354. '
  355. '  SUBROUTINE NAME    -- SRCHCMND
  356. '
  357. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  358. '                        STRT.POS      POSITION TO BEGIN SEARCH AT
  359. '                        ALL.OPTS$     STRING TO SEARCH (COMMAND LIST)
  360. '                        Z$            WHAT TO LOOK FOR
  361. '
  362. '  OUTPUT PARAMETERS  -- WHERE.FOUND   POSITION OF Z$ IN ALL.OPTS$
  363. '                                      0 IF NOT FOUND
  364. '
  365. '  SUBROUTINE PURPOSE -- SEARCHES VALID COMMAND LIST FOR THE REQUESTED
  366. '                        COMMAND.  IF THE SYSOP HAS CONFIGURED RBBS-PC TO
  367. '                        RESTRICT COMMANDS TO ONLY THOSE VALID WITHIN THE
  368. '                        RBBS-PC SUBSYSTEM, THEN ONLY THOSE COMMANDS AND
  369. '                        "GLOBAL" COMMANDS ARE VALID.  OTHERWISE ALL COMMANDS
  370. '                        ARE VALID FROM ANY OF THE RBBS-PC SUBSYSTEMS.
  371. '
  372.      SUB SRCHCMND (STRT.POS,WHERE.FOUND) STATIC
  373. * REPLACING old line(s) by new
  374. 1411 Y$ = KEY.PRESSED$
  375.      SUBROUTINE.PARAMETER = PARM
  376.      IF LOCAL.USER THEN _
  377.         GOTO 1430
  378. * ------[ first line different ]------
  379.      CALL FOSREADAHEAD(COMPORT%,CHAR%)                              'FOSS
  380.      IF CHAR% = -1 THEN _                                           'FOSS
  381.         CALL CARRIER : _
  382.         IF SUBROUTINE.PARAMETER = -1 THEN _
  383.            EXIT SUB _
  384.         ELSE GOTO 1430
  385.      CALL GETCOM(Y$)
  386. * REPLACING old line(s) by new
  387. 1525 CALL CARRIER
  388.      IF SUBROUTINE.PARAMETER = -1 THEN _
  389.         EXIT SUB
  390.      IF LEN(COMMPORT.STACK$) > 0 THEN _
  391.         Y$ = LEFT$(COMMPORT.STACK$,1) : _
  392.         COMMPORT.STACK$ = RIGHT$(COMMPORT.STACK$,LEN(COMMPORT.STACK$)-1) : _
  393.         GOTO 1541 _
  394.      ELSE IF LOCAL.USER THEN _
  395.              CALL FINDFUNC: _
  396.              IF SUBROUTINE.PARAMETER < 0 THEN _
  397.                 EXIT SUB_
  398.              ELSE GOTO 1526 _
  399. * ------[ first line different ]------
  400.           ELSE _                                                     'FOSS
  401.               CALL FOSREADAHEAD(COMPORT%,CHAR%) : _                  'FOSS
  402.               IF CHAR% <> -1 THEN _                                  'FOSS
  403.                   CALL GETCOM(Y$) : _
  404.                   IF SUBROUTINE.PARAMETER = -1 THEN _
  405.                      EXIT SUB _
  406.                   ELSE GOTO 1541
  407.      CALL FINDTIME (TI!)
  408.      IF TI! > AUTO.WARN! THEN _
  409.         IF TI! > AUTO.LOGOFF! THEN _
  410.            CALL UPDTCALR ("Sleep disconnect",1) : _
  411.            SUBROUTINE.PARAMETER = -1 : _
  412.            EXIT SUB _
  413.         ELSE IF SLEEP.WARN THEN _
  414.                 SLEEP.WARN = FALSE : _
  415.                 SUBROUTINE.PARAMETER = 2 : _
  416.                 A$ = CHR$(7) + _
  417.                   "LOGGING you OFF if you do not respond in 30 seconds!" + _
  418.                   CHR$(7) : _
  419.                 CALL TPUT
  420.      CALL FINDFUNC
  421.      IF SUBROUTINE.PARAMETER < 0 THEN _
  422.         EXIT SUB
  423. * REPLACING old line(s) by new
  424. * ------[ first line different ]------
  425. 1545 IF INSTR(LINEEDIT.CHK$,Y$) > 4 _                                   'AL0402
  426.         GOTO 1635
  427.      IF Y$ < " " AND Y$ <> CARRIAGE.RETURN$ THEN _
  428.         GOTO 1525
  429.      IF Y$ = "^" THEN _
  430.         GOTO 1525
  431.      IF Y$ = CARRIAGE.RETURN$ THEN _
  432.         IF NO.ADVANCE THEN _
  433.            NO.ADVANCE = FALSE : _
  434.            GOTO 1575 _
  435.         ELSE CALL LPRNT (CARRIAGE.RETURN$ + LINE.FEED$,0) : _
  436.              GOSUB 1551 : _
  437.              GOTO 1570 _
  438.      ELSE GOSUB 1550
  439.      IF LEN(B$) => 254 THEN _
  440.         A$ = "Input too long!" : _
  441.         SUBROUTINE.PARAMETER = 5 : _
  442.         CALL TPUT : _
  443.         IF SUBROUTINE.PARAMETER = -1 OR FUNCTION.KEY <> 0 THEN _
  444.            EXIT SUB _
  445.         ELSE GOTO 1500
  446.      B$ = B$ + _
  447.           Y$
  448.      GOTO 1525
  449. * REPLACING old line(s) by new
  450. 1654 IF NOT KEEP.INIT.BAUD THEN _
  451.         TALK.TO.MODEM.AT$ =  MID$("      300  450 1200 2400 4800 960019200",(-5 * BPS),5) _
  452.      ELSE TALK.TO.MODEM.AT$ = MODEM.INIT.BAUD$
  453.      CALL TRIM (TALK.TO.MODEM.AT$)
  454.      IF LEN(TALK.TO.MODEM.AT$) < 5 THEN _
  455.         TALK.TO.MODEM.AT$ = SPACE$(4 - LEN(TALK.TO.MODEM.AT$)) + _
  456.                             TALK.TO.MODEM.AT$
  457.      IF KEEP.INIT.BAUD THEN _
  458.         EXIT SUB
  459.      IF BPS = -1 THEN _
  460. * ------[ first line different ]------
  461.         COMSPEED%=300 : _
  462.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  463.      IF BPS = -2 THEN _
  464.         COMSPEED%=450 : _
  465.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  466.      IF BPS = -3 THEN _
  467.         COMSPEED%=1200 : _
  468.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  469.      IF BPS = -4 THEN _
  470.         COMSPEED%=2400 : _
  471.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  472.      IF BPS = -5 THEN _
  473.         COMSPEED%=4800 : _
  474.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  475.      IF BPS = -6 THEN _
  476.         COMSPEED%=9600 : _
  477.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  478.      IF BPS = -7 THEN _
  479.         COMSPEED%=19200 : _
  480.         CALL FOSSPEED(COMPORT%,COMSPEED%) : EXIT SUB
  481.      END SUB
  482. ' $SUBTITLE: 'LINEEDIT  - subroutine to produce edited line'
  483. ' $PAGE
  484. '
  485. '  SUBROUTINE NAME    -- LINEEDIT
  486. '
  487. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  488. '                        BACK.ARROW$
  489. '                        BACKSPACE$
  490. '                        CARRIAGE.RETURN$
  491. '                        LINE.FEED$
  492. '                        LINEMES$          BUFFER SPACE TO USE FOR HOLDING LINE
  493. '                        LOCAL.USER
  494. '                        MAX.LEN           MAXIMUM LENGTH OF STRING TO INPUT
  495. '                        MESSAGE.LINE      WHERE IN A$() TO PUT THE EDITED LINE
  496. '                        RIGHT.MARGIN
  497. '                        SNOOP
  498. '                        STOP.INTERRUPTS
  499. '                        WAIT.EXPIRED
  500. '
  501. '  OUTPUT PARAMETERS  -- A$(MESSAGE.LINE)  EDITED LINE
  502. '
  503. '  SUBROUTINE PURPOSE -- SUBROUTINE TO EDIT A LINE QUICKLY USING A MINIMUM OF
  504. '                        STRING SPACE.
  505. '
  506.      SUB LINEEDIT (MESSAGE.LINE,MAX.LEN) STATIC
  507. * REPLACING old line(s) by new
  508. * ------[ first line different ]------
  509. 3732 CALL FOSREADAHEAD(COMPORT%,CHAR%)                           'FOSS
  510.      IF CHAR% <> -1 THEN  _                                      'FOSS
  511.         GOTO 3736
  512.      CALL FINDTIME (TI!)
  513.      IF TI! > AUTO.LOGOFF! THEN _
  514.         WAIT.EXPIRED = TRUE : _
  515.         EXIT SUB
  516. * REPLACING old line(s) by new
  517. 3750 IF SEND.REMOTE THEN _
  518.         CALL PUTCOM(X$)
  519.      CALL LPRNT (X$, 0)
  520. * ------[ first line different ]------
  521.      IF X$ <> CARRIAGE.RETURN$ THEN _                                   'AL0402
  522.         GOTO 3770                                                       'AL0402
  523.      IF (CSRLIN < 24) AND (NOT USE.BASIC.WRITES) THEN _                 'AL0402
  524.         CALL PSCRN(CHR$(13) + CHR$(10))                                 'AL0402
  525.      COL = COL - 1                                                      'AL0402
  526.      GOTO 3850                                                          'AL0402
  527. * REPLACING old line(s) by new
  528. 5510 CALL QTPUT ("Change your baud rate to 450",1)
  529.      CALL DELAYIT (9)
  530.      C = 0
  531. * ------[ first line different ]------
  532.      BPS = -2                                                           'AL0402
  533.      CALL SETBAUD
  534.      A$ = " and then press [ENTER] until I respond"
  535.      SUBROUTINE.PARAMETER = 9
  536.      CALL TGET
  537. * REPLACING old line(s) by new
  538. 5530 C = C + 1
  539.      CALL CARRIER
  540.      IF SUBROUTINE.PARAMETER THEN _
  541.         EXIT SUB
  542.      IF C = 20 THEN _
  543.         CALL UPDTCALR ("Baud change failed",1) : _
  544. * ------[ first line different ]------
  545.         BPS = -1 : _                                                    'AL0402
  546.         CALL SETBAUD : _                                                'AL0402
  547.         EXIT SUB
  548.      CALL DELAYIT (1)
  549. * REPLACING old line(s) by new
  550. * ------[ first line different ]------
  551. 5535 CALL FOSREADAHEAD(COMPORT%,CHAR%)                                  'FOSS
  552.      IF CHAR% = -1 THEN _                                               'FOSS
  553.         GOTO 5530
  554. * REPLACING old line(s) by new
  555. 10605 LSET USER.DOWNLOADS$ = MKI$(DOWNLOADS)
  556.       LSET USER.UPLOADS$ = MKI$(UPLOADS)
  557.       LSET ELAPSED.TIME$ = MKI$(Q!)
  558.       IF ADJUSTED.SECURITY THEN _
  559.          LSET SECURITY.LEVEL$ = MKI$(USER.SECURITY.LEVEL)
  560.       PUT 5,USER.FILE.INDEX
  561. * ------[ first line different ]------
  562.       SUBROUTINE.PARAMETER = 8
  563.       CALL FILELOCK
  564. * REPLACING old line(s) by new
  565. * ------[ first line different ]------
  566. 10994 EXIT.TO.DOORS = TRUE
  567. '      OUT MODEM.CONTROL.REGISTER,INP(MODEM.CONTROL.REGISTER) OR 1   'FOSS
  568.       IF NOT PRIVATE.DOOR THEN _
  569.          CALL MLINIT (2)
  570. * REPLACING old line(s) by new
  571. 10996 IF NOT SYSOP THEN _
  572.          CALL UPDATEU : _
  573.          SUBROUTINE.PARAMETER = 8 : _
  574.          CALL FILELOCK
  575.       CALL GETIME
  576.       CALL UPDATEC
  577.       CALL SAVEPROF (1)
  578.       IF NUM.LINES = 0 THEN _
  579.          EXIT SUB
  580. * ------[ first line different ]------
  581. '     CALL DELAYIT (9 + BPS)                                            'AL0330
  582.       CALL FOSEXIT(COMPORT%)                                          'FOSS 
  583.       SYSTEM
  584.       END SUB
  585. ' $SUBTITLE: 'UNTILRIGHT - subroutine to ask question until answer okay'
  586. ' $PAGE
  587. '
  588. '  SUBROUTINE NAME    -- UNTILRIGHT
  589. '
  590. '  INPUT PARAMETERS   -- PARAMETER             MEANING
  591. '                        QUES$         QUESTION TO BE ASKED THE USER
  592. '                        ANS$          LOCATION TO STORE THE ANSWER
  593. '                        MIN.LEN       MINIMUM LENGTH OF ANSWER
  594. '                        MAX.LEN       MAX LENGTH OF ANSWER
  595. '
  596. '  OUTPUT PARAMETERS  -- ANS$          RESPONSE TO THE QUESTION WHICH THE
  597. '                                      CALLERS SAYS IS CORRECT
  598. '
  599. '  SUBROUTINE PURPOSE -- SUBROUTINE TO ASK A USER A QUESTION UNTIL THE CALLER
  600. '                        RESPONDS THAT THE ANSWER IS CORRECT
  601. '
  602.       SUB UNTILRIGHT (QUES$,ANS$,MIN.LEN,MAX.LEN) STATIC
  603. * REPLACING old line(s) by new
  604. 20288 IF L < LEN(PATTERN$) AND MID$(PATTERN$,L + 1,1) <> "*" THEN _
  605.          OK = FALSE
  606.       END SUB
  607. ' $SUBTITLE: 'SENDNAME - send FILENAME using EXEC-PC protocol'
  608. ' $PAGE
  609. '
  610. '  SUBROUTINE NAME    -- SENDNAME
  611. '
  612. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  613. '                        B$()                ARRAY OF FILENAME FOR AUTODOWNLOAD
  614. '                        DWN.INDEX           INDEX OF FILENAME TO TRANSFER
  615. '
  616. '  OUTPUT PARAMETERS  -- ABORT               -1 FOR AN ABORTED ATTEMPT
  617. '
  618. '  SUBROUTINE PURPOSE -- SEND THE DOWNLOAD FILENAME TO USER DURING AN
  619. '                        AUTODOWNLOAD.
  620. '
  621.       SUB SENDNAME STATIC
  622. '
  623. ' *****************************************************************************
  624. ' *  TRANSFER FILENAME TO USER                                                *
  625. ' *         PROCESS - SEND USER THE "ALERT" CHARACTER SEQUENCE -- <ESC>OD     *
  626. ' *                   THEN THIS IS FOLLOWED BY CHARACTER-BY-CHARACTER         *
  627. ' *                   TRANSMISSION OF THE FILENAME WITH ECHO.  IF ANY OF THE  *
  628. ' *                   CHARACTERS OF THE FILENMAE ARE GARBLED A SERIES OF      *
  629. ' *                   <CAN> ARE SENT, OTHERWISE AN <ACK> IS SENT AT           *
  630. ' *                   COMPLETION AND FILE TRANSFER BEGINS.                    *
  631. ' *****************************************************************************
  632. '
  633. * ------[ first line different ]------
  634. '      ABORT = FALSE                      ' RESET ABORT FLAG
  635. '      ATTEMPTS = 0                       ' RESET COUNT FOR # OF TRANS ATTEMPTS
  636. '20295 CALL DELAYIT (1)                   ' ONE SECOND DELAY
  637. '20296 CALL FLUSHCOM(Y$)                  ' CLEAR THE COMM BUFFER OF GARBAGE
  638. '      IF SUBROUTINE.PARAMETER = -1 THEN _
  639. '         EXIT SUB
  640. '      CALL PUTCOM (ESCAPE$+"OD")         ' SEND "ALERT" STRING         CPC161AI
  641. '      IF SUBROUTINE.PARAMETER = -1 THEN _
  642. '         EXIT SUB
  643. '      IF ABORT = TRUE THEN _
  644. '         GOTO 20306
  645. '      CALL LPRNT("Sending FILENAME -- ",1)
  646. '      CALL LPRNT(RETURN.LINE.FEED$ + CHR$(9),0)
  647. '      CALL DELAYIT (1)                   ' WAIT 1 SECOND FOR SETUP
  648. ''
  649. ''               SEND ONE CHARACTER AT A TIME
  650. ''
  651. '      A$ = B$(DWN.INDEX) + _
  652. '           "=X"
  653. '      FOR X = 1 TO LEN(A$)
  654. '         CALL PUTCOM (MID$(A$,X,1))     ' SEND 1 CHARACTER
  655. '         IF SUBROUTINE.PARAMETER = -1 THEN _
  656. '            EXIT SUB
  657. '         IF ABORT = TRUE THEN _
  658. '            GOTO 20306
  659. '         CALL LPRNT(MID$(A$,X,1),0)     ' DISPLAY IF NEEDED
  660. '         IF TIMER < 86390! THEN _
  661. '            DELAY! = TIMER + 10 _
  662. '         ELSE DELAY! = TIMER - 86400! + 10 ' SET MAXIMUM TIME TO WAIT FOR REPLY
  663. '         WHILE EOF(3)
  664. '            IF TIMER > DELAY! THEN _
  665. '               GOTO 20300     ' IF NO ECHO, CANCEL FILENAME TRANSFER
  666. '         WEND                 ' JUMP OUT IF CHARACTER IS RECEIVED
  667. '20298    CALL FLUSHCOM(Y$)    ' COLLECT CHARACTER(S) USER ECHOED
  668. '         IF SUBROUTINE.PARAMETER = -1 THEN _
  669. '            EXIT SUB
  670. '         IF MID$(A$,X,1) = Y$ THEN _
  671. '            GOTO 20305         ' IF CORRECTLY ECHOED, THEN CONTINUE
  672. '         IF INSTR(Y$,CANCEL$) THEN _
  673. '            ABORT = TRUE : _
  674. '            GOTO 20306          ' CHECK FOR USER ABORT
  675. '20300    CALL PUTCOM (STRING$(5,24)) ' TELL USER THAT FILE NAME IS GARBLED
  676. '         IF SUBROUTINE.PARAMETER = - 1 THEN _
  677. '            EXIT SUB
  678. '         IF ABORT = TRUE THEN _
  679. '            GOTO 20306
  680. '         CALL LPRNT("Name Trans Failure",1) ' DISPLAY FAILURE ON SCREEN
  681. '         ATTEMPTS = ATTEMPTS + 1  ' INCREMENT COUNTER FOR # OF TRIES
  682. '         IF ATTEMPTS < 6 THEN _   ' TRY IT FIVE TIMES, THEN GIVE UP
  683. '            GOTO 20295
  684. '         CALL PUTCOM (STRING$(50,24)) ' GUARANTEE CANCELLATION OF USER
  685. '         IF SUBROUTINE.PARAMETER = -1 THEN _
  686. '            EXIT SUB
  687. '         IF ABORT = TRUE THEN _
  688. '            GOTO 20306
  689. '         IF SNOOP THEN _
  690. '            CALL LPRNT("ABORTING AUTODOWNLOAD!",1) : _
  691.             ABORT = TRUE : _
  692.             GOTO 20306
  693. '
  694. '20305 NEXT                               ' LOOP BACK FOR NEXT CHARACTER
  695. '
  696. '      CALL PUTCOM (ACKNOWLEDGE$)    ' WHEN FILENAME SENT, ACKNOWLEDGE
  697. '      IF SUBROUITNE.PARAMETER = -1 THEN _
  698. '         EXIT SUB
  699. '      CALL SKIPLINE(1)              ' CLEAN UP SYSOP'S DISPLAY
  700. '
  701. '                COMPLETION OF AUTODOWNLOAD FILENAME TRANSFER
  702. '
  703. * DELETING old line(s)
  704. 20295
  705. 20296
  706. 20298
  707. 20300
  708. 20305
  709. * REPLACING old line(s) by new
  710. 20306 END SUB
  711. ' $SUBTITLE: 'TESTUSER - interrogate user for AUTO-DOWNLOADING protocol'
  712. ' $PAGE
  713. '
  714. '  SUBROUTINE NAME    -- TESTUSER
  715. '
  716. '  INPUT PARAMETERS   -- NONE
  717. '
  718. '  OUTPUT PARAMETERS  -- AUTODOWNLOAD.AVAILABLE   -1 IF USER'S COMMUNICATION
  719. '                                                      SOFTWARE CAN DO AUTO-
  720. '                                                      DOWNLOADING
  721. '
  722. '                        AUTODOWNLOAD.VERIFIED    TRUE IF COMMUNICATIONS PGM
  723. '                                                      EVER CHECKED
  724. '
  725. '  SUBROUTINE PURPOSE -- SEND THE USER AN <ESCAPE><XON> AND IF RESPONSE
  726. '                        IS A RECOGNIZED PACKAGE, SET APPROPRIATE FLAG.
  727. '
  728.       SUB TESTUSER STATIC
  729. '
  730. ' *****************************************************************************
  731. ' *    TEST FOR COMMUNICATIONS USING N,8,1 PROTOCOL AND EXECPC TALK VER 2.0+  *
  732. ' *     TO SEE IF CALLER CAN USE THE AUTODOWNLOAD FEATURE                     *
  733. ' *****************************************************************************
  734. '
  735. * ------[ first line different ]------
  736. '20310 ABORT = FALSE
  737.      AUTODOWNLOAD.VERIFIED = TRUE
  738. '     CALL FLUSHCOM(Y$)                          ' FLUSH THE COMM BUFFER
  739. '     IF SUBROUTINE.PARAMETER = -1 THEN _
  740. '        EXIT SUB
  741. '     CALL PUTCOM (ESCAPE$ + XON$)
  742. '     IF ABORT = TRUE THEN _
  743. '        GOTO 20315
  744. '     CALL DELAYIT (2)                            ' WAIT TWO SECONDS FOR REPLY
  745. '20313 CALL FLUSHCOM(Y$)                           ' GET CONTENTS OF COMM BUFFER
  746. '      IF SUBROUTINE.PARAMETER = -1 THEN _
  747. '         EXIT SUB
  748. '      IF INSTR(Y$,"EXECPC") THEN _
  749. '         COM.PROGRAM = 1
  750. '      IF INSTR(Y$,"PIBTERM") THEN _
  751. '         COM.PROGRAM = 2
  752. '      IF INSTR(Y$,"PROCOMM") THEN _
  753. '         COM.PROGRAM = 3
  754. '      IF INSTR(Y$,"QMODEM") THEN _
  755. '         COM.PROGRAM = 4
  756. '      AUTODOWNLOAD.AVAILABLE = (COM.PROGRAM > 0 AND COM.PROGRAM < 3)
  757. * DELETING old line(s)
  758. 20310
  759. 20313
  760. * REPLACING old line(s) by new
  761. 20725 EN$ = UPLOAD.DIRECTORY$
  762.       IF FMS.DIRECTORY$ = UPLOAD.DIRECTORY$ OR LIMIT.SEARCH.TO.FMS THEN _
  763.          B$ = DESC$ + _
  764.               SPACE$(MAX.DESC.LEN - LEN(DESC$)) + _
  765.               Y$ + _
  766.               SPACE$(3 - LEN(Y$))
  767.       GOSUB 20730
  768. * ------[ first line different ]------
  769.       EN$ = "$" + RIGHT$(DATE$,2) + LEFT$(DATE$,2) + ".UPL"             'AL0402
  770.       GOSUB 20730                                                       'AL0402
  771. * REPLACING old line(s) by new
  772. 20730 '          ---[ lock file ]---
  773.       IF EN$ = "" THEN _
  774.          RETURN
  775.       BX = &H4
  776.       SUBROUTINE.PARAMETER = 9
  777.       CALL FILELOCK
  778.       CLOSE 2
  779.       IF SHARE.IT THEN _
  780.          OPEN EN$ FOR APPEND SHARED AS #2 _
  781.       ELSE OPEN "A",2,EN$
  782.       '          ---[ append ]---
  783. * ------[ first line different ]------
  784.       IF RIGHT$(EN$,4) = ".UPL" THEN _                                  'AL0402
  785.            PRINT #2,USING "\           \########  &  & &"; _            'AL0402
  786.                           FILE.NAME.HOLD$; BYTES.IN.FILE#; Z$; B$; _    'AL0402
  787.                           ACTIVE.USER.NAME$ _                           'AL0402
  788.       ELSE PRINT #2,USING "\           \########  &  &"; _              'AL0402
  789.                           FILE.NAME.HOLD$; BYTES.IN.FILE#; Z$; B$       'AL0402
  790.       CLOSE 2
  791.       '          ---[ unlock ]---
  792.       BX = &H4
  793.       SUBROUTINE.PARAMETER = 10
  794.       CALL FILELOCK
  795.       RETURN
  796.       END SUB
  797. ' $SUBTITLE: 'BADFILE - subroutine to find bad file names'
  798. ' $PAGE
  799. '
  800. '  SUBROUTINE NAME    -- BADFILE
  801. '
  802. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  803. '                        VIOLATION$
  804. '                        VIOLATIONS.THIS.SESSION
  805. '                        FILNAME$                      NAME OF FILE
  806. '
  807. '  OUTPUT PARAMETERS  -- RESULT                      1 = FILE NAME IS OK
  808. '                                                    2 = CHARACTER NOT ALLOWED
  809. '                                                    3 = SYSTEM CRASH ATTEMPT
  810. '                        VIOLATIONS.THIS.SESSION     NUMBER OF VIOLATIONS
  811. '                        FILNAME$                    Gets capitalized
  812. '
  813. '  SUBROUTINE PURPOSE -- TO PROTECT RBBS-PC AGAINST THE USE OF BAD FILE NAMES
  814. '                        TO EITHER CRASH THE SYSTEM OR TO BREACH RBBS-PC'S
  815. '                        SECURITY
  816. '
  817.       SUB BADFILE (FILNAME$,RESULT) STATIC
  818. '
  819. ' *****************************************************************************
  820. ' *  TEST FOR INVALID CHARACTERS IN FILENAME                                  *
  821. ' *****************************************************************************
  822. '
  823. * REPLACING old line(s) by new
  824. 20742 VIOLATIONS.THIS.SESSION = MAXIMUM.VIOLATIONS
  825.       VIOLATION$ = VIOLATION$ + _
  826.                    FILNAME$
  827.       RESULT = 3
  828.       END SUB
  829. ' $SUBTITLE: 'LIBRARY - subroutine to support Library downloads'
  830. ' $PAGE
  831. '
  832. '  SUBROUTINE NAME    -- LIBRARY
  833. '
  834. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  835. '                            SUBROUTINE.PARAMETER     1 = DISPLAY ACTIVE AREA
  836. '                                                     2 = CHANGE ACTIVE AREA
  837. '                                                     3 = DISPLAY PC-SIG
  838. '                                                         DISCLAIMER
  839. '                                                     4 = ARCHIVE LIBRARY DISK
  840. '                                                     5 = DOWNLOAD COMPLETED
  841. '                            LIBRARY.TYPE             0 = NO LIBRARY ACTIVE
  842. '                                                     1 = LIBRARY FROM PC-SIG
  843. '                            LIBRARY.DRIVE$           LIBRARY DRIVE ID
  844. '
  845. '  OUTPUT PARAMETERS  -- NONE
  846. '
  847. '  SUBROUTINE PURPOSE -- TO PROVIDE ACCESSS SUPPORT FOR LIBRARY DRIVES
  848. '
  849.       SUB LIBRARY STATIC
  850. * ------[ first line different ]------
  851.       END SUB
  852. ' $SUBTITLE: 'XFERTYPE - subroutine to identify file xfer protocol'
  853. ' $PAGE
  854. '
  855. '  SUBROUTINE NAME    -- XFERTYPE
  856. '
  857. '  INPUT PARAMETERS   --     PARAMETER                    MEANING
  858. '                        A$
  859. '                        B$(1)
  860. '                        Q
  861. '                        RELIABLE.MODE
  862. '                        TRANSFER.OPTIONS$
  863. '                        USER.TRANSFER.DEFAULT$
  864. '                        KERMIT.SUPPORT                                 'AL0331
  865. '                        DSZ.SUPPORT                                    'AL0331
  866. '                        CLINK.SUPPORT                                  'AL0331
  867. '
  868. '  OUTPUT PARAMETERS  -- CHECKSUM
  869. '                        FLEN
  870. '                        FT$
  871. '
  872. '  SUBROUTINE PURPOSE -- TO IDENTIFY THE FILE TRANSFER PROTOCOL (EITHER
  873. '                        FROM THE USER'S DEFAULT OR VIA EXPLICIT SELECTION)
  874. '
  875.       SUB XFERTYPE(INDEX,SKIP.HELP) STATIC
  876.       ON INDEX GOTO 21600,21620
  877. '
  878. ' *****************************************************************************
  879. ' *  MANUAL SELECT OF TRANSFER PROTOCOL                                       *
  880. ' *****************************************************************************
  881. '
  882. * DELETING old line(s)
  883. 21105
  884. 21110
  885. 21115
  886. 21117
  887. 21120
  888. 21121
  889. 21122
  890. 21126
  891. 21130
  892. 21140
  893. 21145
  894. 21150
  895. 21151
  896. 21152
  897. 21153
  898. 21155
  899. 21156
  900. 21157
  901. 21158
  902. 21159
  903. * REPLACING old line(s) by new
  904. 21610 CALL ALLCAPS (Z$)
  905.       IF INSTR("H?",Z$) > 0 THEN _
  906.          GOTO 21602
  907.       FF = INSTR(DFLTXFER$,Z$)
  908. * ------[ first line different ]------
  909.       BLOCK.SIZE = 1                                                    'AL0331
  910.       IF Z$ = "N" THEN _
  911.          FF = 10                                                        'AL0402
  912.       IF FF < 1 THEN _
  913.          GOTO 21600
  914.       IF FF < 4 THEN _
  915.          GOTO 21612
  916.       IF FF = 4 AND NOT KERMIT.SUPPORT THEN _                           'AL0331
  917.          GOTO 21600                                                     'AL0331
  918.       IF FF > 4 AND FF < 9 THEN _                                       'AL0402
  919.          BLOCK.SIZE = 8 : _                                             'AL0331
  920.          IF FF = 5 THEN _                                               'AL0331
  921.             GOTO 21612                                                  'AL0331
  922.       IF (FF > 4 AND FF < 9) AND NOT DSZ.SUPPORT THEN _                 'AL0402
  923.          GOTO 21600                                                     'AL0331
  924.       IF FF = 7 AND NOT RELIABLE.MODE THEN _                            'AL0402
  925.          GOTO 21600                                                     'AL0402
  926.       IF FF = 9 AND NOT CLINK.SUPPORT THEN _                            'AL0402
  927.          GOTO 21600                                                     'AL0331
  928. * REPLACING old line(s) by new
  929. 21612 FT$ = MID$(DFLTXFER$,FF,1)
  930.       CHECKSUM = (FF = 2)
  931. * ------[ first line different ]------
  932.       FLEN = 128 - 896 * (BLOCK.SIZE = 8)                               'AL0331
  933.       GOTO 21621
  934.